perm filename CB.OLD[MSS,LCS]2 blob
sn#106234 filedate 1974-06-12 generic text, type T, neo UTF8
00100 SUBROUTINE CMBN
00200 COMMON /RC/MCLEF(400),IST(4000)
00300 COMMON /FL/NX,N,L,M,NM,J,NT
00400 DIMENSION IP(10),NMS(10),NF(2500),JP(10),NMX(10)
00500 EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
00525 1,(JP,IST(1500)),(NMX,IST(1510))
00550 C ***** ****** **** ****** ↑ 20 FOR OVERRUN IN IP(11) AT 119
00600 C USE FILE NAMES CLFX, DRAW1 AND DRAW2. 400 WD LIMIT PER FILE.
00610 IF(N.EQ.'S')GO TO 103
00700 102 TYPE 1
00800 1 FORMAT(' TYPE OUTPUT FILE NAME ',$)
00900 10 FORMAT(A5)
00910 DO 122 K=1,10
00920 IP(K)=0
00955 122 NMS(K)=' '
01000 ACCEPT 10,NM
01050 IF(NM.NE.' ')GO TO 40
01055 NM=LASTNM
01057 TYPE 107,LASTNM
01060 40 LASTNM=NM
01100 IF(LOOKF(NM).EQ.0)GO TO 100
01110 IF(N.NE.'C')GO TO 103
01120 C FOR ADDING TO COMBINED FILE.
01200 TYPE 101,NM
01300 ACCEPT 10,NX
01400 IF(NX.EQ.'N')GO TO 102
01410 100 IF(N.EQ.'C')GO TO 104
01420 TYPE 52
01430 GO TO 102
01800 104 L=0
01900 NX=1
02000 I=0
02050 30 L=L+1
02100 TYPE 41
02200 41 FORMAT(' TYPE FILE NAME ',$)
02300 ACCEPT 10,NW
02400 IF(NW.EQ.' ')GO TO 8
02500 IF(LOOKF(NW))GO TO 51
02600 TYPE 52
02700 GO TO 30
02800 52 FORMAT(' FILE NOT FOUND'/)
02900 51 I=I+1
02910 IP(L)=NX
03000 NMS(I)=NW
03100 CALL RDSAV(JP,NMX,K,NW,MCLEF(NX),-2)
03200 NX=NX+K
03300 IF(L.LT.10)GO TO 30
04900 101 FORMAT(' WRITE OVER ',A5,'.DMD? Y OR N? ',$)
05600 8 NX=NX-1
05700 14 CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
05750 L=NX
05800 RETURN
07210
07220 1103 TYPE 1104,ID
07230 1104 FORMAT(' FILE FULL -- SAVED AS ',A5)
07240 L=1
07245 NM=ID
07250 NX=MCLEF(1)
07260 GO TO 8
07300
07400 103 CALL RDSAV(IP,NMS,NX,NM,NF,-1)
08100 107 FORMAT(1X,A5)
08400 TYPE 109
08500 109 FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
08600 ACCEPT 10,ID
08610 IF(ID.EQ.' ')GO TO 102
08800 JD=0
08820 L=0
08840 CC NX=NX-1
08900 DO 110 K=1,10
09000 IF(NMS(K).EQ.ID)JD=K
09100 IF(NMS(K).EQ.' ')GO TO 112
09105 L=K
09110 110 IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
09210 112 IF(N.EQ.'Z')GO TO 127
09230 C FOR DELETIONS
09250 L=L+1
09300 IF(JD.NE.0)GO TO 111
09310 C ADDS ON TO END
09500 N=0
09550 IP(L)=NX+1
09600 DO 113 K=NX+1,MCLEF(1)+NX
09700 N=N+1
09800 113 NF(K)=MCLEF(N)
09900 NX=NX+N
10000 NMS(L)=ID
10010 L=L+1
10100 114 DO 115 K=1,NX
10200 115 MCLEF(K)=NF(K)
10300 C MOVES IT ALL TO MCLEF
10400 GO TO 14
10500
10600 127 MCLEF(1)=0
10700 111 N=IP(JD)
10800 NR=MCLEF(1)
10900 M=NF(IP(JD))
11000 NW=NR-M
11010 NX=NX+NW
11020 IF(NW)201,120,203
11030 201 JA=N+NR
11040 JB=NX
11050 JC=1
11060 GO TO 204
11070 203 JA=NX
11080 JB=N+NW
11090 JC=-1
11100 204 DO 121 K=JA,JB,JC
11110 121 NF(K)=NF(K-NW)
11120 IF(NR.EQ.0)GO TO 126
11200 120 DO 117 K=1,NR
11300 NF(N)=MCLEF(K)
11400 117 N=N+1
11410 CC L=L-1
11420 IF(NW.EQ.0)GO TO 114
12000 DO 119 K=JD+1,L
12100 119 IP(K)=IP(K)+NW
12200 C FIXES UP FIRST LINE.
12220 CC123 L=L-1
12260 CC NX=NX-1
12300 GO TO 114
12400 126 IP(L+1)=0
12410 CC L=L-1
12420 DO 124 K=JD,L-1
12440 IP(K)=IP(K+1)+NW
12460 124 NMS(K)=NMS(K+1)
12470 NMS(L)=' '
12480 GO TO 114
12900 END
13000
13100 SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
13200 C POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
13300 COMMON /RC/MCLEF(400),IST(4000)/FL/IC,NH,NQ,A,B,C,D
13400 DIMENSION KT(1),NMS(1),IO(1),JALL(21)
13420 IF(L)GO TO 5
13460 C L=-1 FOR READER, -2=NO TYPE OF NAME LIST.
13500 DO 1 N=1,10
13600 JALL(N)=KT(N)
13700 1 JALL(N+11)=NMS(N)
13800 JALL(11)=K
14100 CALL PUTFIL(NAME)
14200 CALL FASTOU(JALL,21)
14300 CALL FASTOU(IO,K+1)
14400 CALL FINFIL
14500 RETURN
14600
14700 5 CALL GETFIL(NAME)
14800 CALL FASTIN(JALL,21)
14900 K=JALL(11)
15000 CALL FASTIN(IO,K)
15100 DO 2 N=1,10
15200 KT(N)=JALL(N)
15300 2 NMS(N)=JALL(N+11)
15350 IF(L.EQ.-2)RETURN
15400 TYPE 3
15500 TYPE 4,(NMS(N),N=1,10)
15600 3 FORMAT(
15700 1' 0 1 2 3 4 5 6 7
15800 1 8 9')
15900 4 FORMAT(' IDENT. NAMES:'/,10(2XA5))
16000 END
16100
16700 SUBROUTINE CNVT
16800 COMMON/RC/A(4400)
17000 DIMENSION J(10),NM(10),M(600),JALL(21)
17100 EQUIVALENCE(J,JALL,A),(NX,JALL(11)),(NM,JALL(12)),(M,A(2000))
17200 C POINTER LIST, TOTAL WD CNT, NAME LIST.
17300 TYPE 1
17400 1 FORMAT(' TYPE OLD NAME -- '$)
17500 ACCEPT 2,N
17600 2 FORMAT(A5)
17700 TYPE 3
17800 3 FORMAT(' NEW NAME -- '$)
17900 ACCEPT 2,NN
18000 CALL IFILE(1,N)
18100 NX=1
18200 READ(1,4)K,J
18300 4 FORMAT(12I)
18400 6 READ(1,4,END=5)K,K,(M(L),L=NX,NX+K-1)
18500 REREAD 7,L,NM
18600 IF(NM(1))GO TO 5
18700 NX=NX+K
18800 GO TO 6
18900 7 FORMAT(I,10A5)
19000
19300 5 NX=NX-1
19700 CALL RDSAV(J,NM,NX,NN,M,0)
19750 C POINTERS, NAMES, WDCNT, FILE NAME, ARRAY, 0=WRITE
19800 CALL EXIT
19900 END